home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / PCSSP.LZH / PC-SSP.ZIP / STATCORR.ZIP / GDATA.FOR < prev    next >
Text File  |  1985-11-29  |  4KB  |  141 lines
  1. C
  2. C     ..................................................................
  3. C
  4. C        SUBROUTINE GDATA
  5. C
  6. C        PURPOSE
  7. C           GENERATE INDEPENDENT VARIABLES UP TO THE M-TH POWER (THE
  8. C           HIGHEST DEGREE POLYNOMIAL SPECIFIED) AND COMPUTE MEANS,
  9. C           STANDARD DEVIATIONS, AND CORRELATION COEFFICIENTS.  THIS
  10. C           SUBROUTINE IS NORMALLY CALLED BEFORE SUBROUTINES ORDER,
  11. C           MINV AND MULTR IN THE PERFORMANCE OF A POLYNOMIAL
  12. C           REGRESSION.
  13. C
  14. C        USAGE
  15. C           CALL GDATA (N,M,X,XBAR,STD,D,SUMSQ)
  16. C
  17. C        DESCRIPTION OF PARAMETERS
  18. C           N     - NUMBER OF OBSERVATIONS.
  19. C           M     - THE HIGHEST DEGREE POLYNOMIAL TO BE FITTED.
  20. C           X     - INPUT MATRIX (N BY M+1) .  WHEN THE SUBROUTINE IS
  21. C                   CALLED, DATA FOR THE INDEPENDENT VARIABLE ARE
  22. C                   STORED IN THE FIRST COLUMN OF MATRIX X, AND DATA FOR
  23. C                   THE DEPENDENT VARIABLE ARE STORED IN THE LAST
  24. C                   COLUMN OF THE MATRIX.  UPON RETURNING TO THE
  25. C                   CALLING ROUTINE, GENERATED POWERS OF THE INDEPENDENT
  26. C                   VARIABLE ARE STORED IN COLUMNS 2 THROUGH M.
  27. C           XBAR  - OUTPUT VECTOR OF LENGTH M+1 CONTAINING MEANS OF
  28. C                   INDEPENDENT AND DEPENDENT VARIABLES.
  29. C           STD   - OUTPUT VECTOR OF LENGTH M+1 CONTAINING STANDARD
  30. C                   DEVIATIONS OF INDEPENDENT AND DEPENDENT VARIABLES.
  31. C           D     - OUTPUT MATRIX (ONLY UPPER TRIANGULAR PORTION OF THE
  32. C                   SYMMETRIC MATRIX OF M+1 BY M+1) CONTAINING CORRELA-
  33. C                   TION COEFFICIENTS.  (STORAGE MODE OF 1)
  34. C           SUMSQ - OUTPUT VECTOR OF LENGTH M+1 CONTAINING SUMS OF
  35. C                   PRODUCTS OF DEVIATIONS FROM MEANS  OF INDEPENDENT
  36. C                   AND DEPENDENT VARIABLES.
  37. C
  38. C        REMARKS
  39. C           N MUST BE GREATER THAN M+1.
  40. C           IF M IS EQUAL TO 5 OR GREATER, SINGLE PRECISION MAY NOT BE
  41. C           SUFFICIENT TO GIVE SATISFACTORY COMPUTATIONAL RESULTS.
  42. C
  43. C        SUBROUTINES AND FUNCTION SUBPROGRAMS REQUIRED
  44. C           NONE
  45. C
  46. C        METHOD
  47. C           REFER TO B. OSTLE, 'STATISTICS IN RESEARCH', THE IOWA STATE
  48. C           COLLEGE PRESS, 1954, CHAPTER 6.
  49. C
  50. C     ..................................................................
  51. C
  52.       SUBROUTINE GDATA (N,M,X,XBAR,STD,D,SUMSQ)
  53.       DIMENSION X(1),XBAR(1),STD(1),D(1),SUMSQ(1)
  54. C
  55. C        ...............................................................
  56. C
  57. C        IF A DOUBLE PRECISION VERSION OF THIS ROUTINE IS DESIRED, THE
  58. C        C IN COLUMN 1 SHOULD BE REMOVED FROM THE DOUBLE PRECISION
  59. C        STATEMENT WHICH FOLLOWS.
  60. C
  61. C     DOUBLE PRECISION X,XBAR,STD,D,SUMSQ,T1,T2
  62. C
  63. C        THE C MUST ALSO BE REMOVED FROM DOUBLE PRECISION STATEMENTS
  64. C        APPEARING IN OTHER ROUTINES USED IN CONJUNCTION WITH THIS
  65. C        ROUTINE.
  66. C
  67. C        THE DOUBLE PRECISION VERSION OF THIS SUBROUTINE MUST ALSO
  68. C        CONTAIN DOUBLE PRECISION FORTRAN FUNCTIONS.  SQRT AND ABS IN
  69. C        STATEMENT 180 MUST BE CHANGED TO DSQRT AND DABS.
  70. C
  71. C        ...............................................................
  72. C
  73. C     GENERATE INDEPENDENT VARIABLES
  74. C
  75.       IF(M-1) 105, 105, 90
  76.    90 L1=0
  77.       DO 100 I=2,M
  78.       L1=L1+N
  79.       DO 100 J=1,N
  80.       L=L1+J
  81.       K=L-N
  82.   100 X(L)=X(K)*X(J)
  83. C
  84. C     CALCULATE MEANS
  85. C
  86.   105 MM=M+1
  87.       DF=N
  88.       L=0
  89.       DO 115 I=1,MM
  90.       XBAR(I)=0.0
  91.       DO 110 J=1,N
  92.       L=L+1
  93.   110 XBAR(I)=XBAR(I)+X(L)
  94.   115 XBAR(I)=XBAR(I)/DF
  95. C
  96.       DO 130 I=1,MM
  97.   130 STD(I)=0.0
  98. C
  99. C     CALCULATE SUMS OF CROSS-PRODUCTS OF DEVIATIONS
  100. C
  101.       L=((MM+1)*MM)/2
  102.       DO 150 I=1,L
  103.   150 D(I)=0.0
  104.       DO 170 K=1,N
  105.       L=0
  106.       DO 170 J=1,MM
  107.       L2=N*(J-1)+K
  108.       T2=X(L2)-XBAR(J)
  109.       STD(J)=STD(J)+T2
  110.       DO 170 I=1,J
  111.       L1=N*(I-1)+K
  112.       T1=X(L1)-XBAR(I)
  113.       L=L+1
  114.   170 D(L)=D(L)+T1*T2
  115.       L=0
  116.       DO 175 J=1,MM
  117.       DO 175 I=1,J
  118.       L=L+1
  119.   175 D(L)=D(L)-STD(I)*STD(J)/DF
  120.       L=0
  121.       DO 180 I=1,MM
  122.       L=L+I
  123.       SUMSQ(I)=D(L)
  124.   180 STD(I)= SQRT( ABS(D(L)))
  125. C
  126. C     CALCULATE CORRELATION COEFFICIENTS
  127. C
  128.       L=0
  129.       DO 190 J=1,MM
  130.       DO 190 I=1,J
  131.       L=L+1
  132.   190 D(L)=D(L)/(STD(I)*STD(J))
  133. C
  134. C     CALCULATE STANDARD DEVIATIONS
  135. C
  136.       DF=SQRT(DF-1.0)
  137.       DO 200 I=1,MM
  138.   200 STD(I)=STD(I)/DF
  139.       RETURN
  140.       END
  141.